home *** CD-ROM | disk | FTP | other *** search
/ The Best of MacTutor - S…e Code for Volumes 1 to 5 / The Best of MacTutor - Source Code for Volume 1-5 (Wayzata Technology)(6031)(1990).bin / Source Code / #18 (Mar 87) / Forth SCSI / SCSI.mount.edit < prev   
Text File  |  1987-02-10  |  9KB  |  479 lines
  1. ( Forth SCSI routines, J. Langowski Dec. 1986 )
  2. only forth also mac also assembler
  3.  
  4. CODE SCSIReset
  5.     CLR.W -(A7)
  6.     MOVE.W #0,-(A7)
  7.     _SCSIDispatch
  8.     MOVE.W (A7)+,D0
  9.     EXT.L    D0
  10.     MOVE.L D0,-(A6)
  11.     RTS
  12. END-CODE
  13.  
  14. CODE SCSIGet
  15.     CLR.W -(A7)
  16.     MOVE.W #1,-(A7)
  17.     _SCSIDispatch
  18.     MOVE.W (A7)+,D0
  19.     EXT.L    D0
  20.     MOVE.L D0,-(A6)
  21.     RTS
  22. END-CODE
  23.  
  24. CODE SCSISelect ( TargetID -- SCSIErrorResult )
  25.     MOVE.L (A6)+,D0
  26.     CLR.W -(A7)
  27.     MOVE.W D0,-(A7)
  28.     MOVE.W #2,-(A7)
  29.     _SCSIDispatch
  30.     MOVE.W (A7)+,D0
  31.     EXT.L    D0
  32.     MOVE.L D0,-(A6)
  33.     RTS
  34. END-CODE
  35.  
  36. CODE SCSICmd ( buffer count -- SCSIErrorResult )
  37.     MOVE.L (A6)+,D0
  38.     MOVE.L (A6)+,D1
  39.     CLR.W -(A7)
  40.     MOVE.L D1,-(A7)
  41.     MOVE.W D0,-(A7)
  42.     MOVE.W #3,-(A7)
  43.     _SCSIDispatch
  44.     MOVE.W (A7)+,D0
  45.     EXT.L    D0
  46.     MOVE.L D0,-(A6)
  47.     RTS
  48. END-CODE
  49.  
  50. CODE SCSIComplete ( waitTicks mess stat -- SCSIErrorResult )
  51.     CLR.W -(A7)
  52.     MOVE.L (A6)+,-(A7)
  53.     MOVE.L (A6)+,-(A7)
  54.     MOVE.L (A6)+,-(A7)
  55.     MOVE.W #4,-(A7)
  56.     _SCSIDispatch
  57.     MOVE.W (A7)+,D0
  58.     EXT.L    D0
  59.     MOVE.L D0,-(A6)
  60.     RTS
  61. END-CODE
  62.  
  63. 1 CONSTANT SCInc
  64. 2 CONSTANT SCnoInc
  65. 3 CONSTANT SCAdd
  66. 4 CONSTANT SCMove
  67. 5 CONSTANT SCLoop
  68. 6 CONSTANT SCNop
  69. 7 CONSTANT SCStop
  70. 8 CONSTANT SCComp
  71.  
  72. variable scbuf 2048 vallot  ( general purpose SCSI buffer )
  73. variable scmess    variable scstat 
  74.     ( used only within the lower-level routines )
  75.  
  76. create SCSIProg
  77.     scnoinc w,    
  78.         0 , ( buffer address )        
  79.         0 , ( # of bytes to transfer )
  80.     scstop  w,
  81.  
  82. : >scbuf scsiprog  2+ ! ;
  83. : >sc#bytes scsiprog 6 + ! ;
  84.  
  85. ( lower level SCSI routines )
  86.  
  87. : initiate.scsi ( cmdblk device# -- )
  88.     SCSIGet abort"  get error"
  89.     ( dev# ) SCSISelect abort"  select error"
  90.     ( cmdblk ) dup 1+ swap c@ SCSICmd abort"  cmd error"
  91. ;
  92.  
  93. : finish.scsi ( #ticks -- message status )
  94.     ( #ticks )  scmess scstat SCSIComplete abort"  complete error"
  95.     scmess w@ scstat w@
  96. ;
  97.  
  98. ( general purpose SCSI handler routines )
  99. ( five different words are provided, depending on whether         )
  100.  
  101. (    - no data phase is necessary :  DOSCSI                )
  102.  
  103. (    - data will be transferred TO the initiator, i.e. the Mac :    )
  104. (      DOSCSI.R for normal reads, DOSCSI.RB for blind reads    )
  105.  
  106. (    - data will be transferred FROM the initiator :            )
  107. (      DOSCSI.W for normal writes, DOSCSI.WB for blind writes    )
  108.  
  109. : doscsi ( #ticks cmdblk device# -- message status )
  110.     initiate.scsi
  111.     finish.scsi
  112. ;
  113.  
  114. : doscsi.r 
  115.     ( #ticks cmdblk device# buf #bytes -- message status )
  116.     >sc#bytes  >scbuf 
  117.     initiate.scsi
  118.     SCSIProg call SCSIRead abort" SCSI read error"
  119.     finish.scsi
  120. ;
  121.  
  122. : doscsi.w 
  123.     ( #ticks cmdblk device# buf #bytes -- message status )
  124.     >sc#bytes  >scbuf 
  125.     initiate.scsi
  126.     SCSIProg call SCSIWrite abort" SCSI write error"
  127.     finish.scsi
  128. ;
  129.  
  130. : doscsi.rb 
  131.     ( #ticks cmdblk device# buf #bytes -- message status )
  132.     >sc#bytes  >scbuf 
  133.     initiate.scsi
  134.     SCSIProg call SCSIRBlind abort" SCSI read blind error"
  135.     finish.scsi
  136. ;
  137.  
  138. : doscsi.wb 
  139.     ( #ticks cmdblk device# buf #bytes -- message status )
  140.     >sc#bytes  >scbuf 
  141.     initiate.scsi
  142.     SCSIProg call SCSIWBlind abort" SCSI write blind error"
  143.     finish.scsi
  144. ;
  145.  
  146. HEX
  147. ( SCSI command block definitions )
  148. ( first byte contains command length, following bytes the command )
  149.  
  150. create test.rdy.blk
  151.     6 c,
  152.     0 c,    ( test unit ready )
  153.     0 , 
  154.     0 w,    ( word align )
  155.  
  156. create rezero.blk
  157.     6 c,
  158.     1 c,    ( rezero unit )
  159.     0 , 0 w,
  160.  
  161. create reqsense.blk
  162.     6 c,
  163.     3 c,    ( request sense )
  164.     13 ,    ( 19 bytes of sense data )
  165.     0 w,
  166.  
  167. create format.blk
  168.     6 c,
  169.     4 c,    ( format unit )
  170.     0 c,    ( default formatting )
  171.     0 c,    ( data pattern )
  172.     0 w,    ( interleave, ignored by Q200 )
  173.     0 w,
  174.  
  175. create init.blk ( for erasing and initializing unit )
  176.     6 c,
  177.     4 c,    ( format unit )
  178.     10 c,    ( format using defect list )
  179.     0 c,    ( data pattern )
  180.     0 w,    ( interleave, ignored by Q200 )
  181.     0 w,
  182.  
  183. create init.dlist ( defect list for initializing unit )
  184.     1 w, ( data pattern bit set )
  185.     0 w,
  186.  
  187. create reassign.blk
  188.     6 c,
  189.     7 c,    ( reassign blocks )
  190.     0 , 0 w,
  191.  
  192. create read.blk
  193.     6 c,
  194.     8 c,    ( read )
  195.     0 w, 0 c, ( logical block address )
  196.     0 c,    ( # blocks to transfer )
  197.     0 w,
  198.  
  199. create write.blk
  200.     6 c,
  201.     A c,    ( write )
  202.     0 w, 0 c, ( logical block address )
  203.     0 c,    ( # blocks to transfer )
  204.     0 w,
  205.  
  206. create seek.blk
  207.     6 c,
  208.     B c,    ( seek )
  209.     0 w, 0 c, ( logical block address )
  210.     0 c,
  211.     0 w,
  212.  
  213. create inquiry.blk
  214.     6 c,
  215.     12 c,    ( inquiry )
  216.     0 w, 0 c,
  217.     34 c,    ( 34 device bytes returned )
  218.     0 w,
  219.  
  220. create modesel.blk
  221.     6 c,
  222.     15 c,    ( mode select )
  223.     0 w, 0 c,
  224.     0 c,    ( param list length )
  225.     0 w,
  226.  
  227. ( reserve, release, copy - not yet implemented )
  228.  
  229. create modesense.blk
  230.     6 c,
  231.     1A c,    ( mode sense )
  232.     0 c,
  233.     0 c,    ( page code )
  234.     0 c,
  235.     0 c,    ( allocation length )
  236.     0 w,
  237.  
  238. create startstop.blk
  239.     6 c,
  240.     1B c,    ( start/stop unit )
  241.     0 c,    ( bit 0 = IMMED )
  242.     0 c, 0 c,
  243.     0 c,     ( bit 0 = START )
  244.     0 w,
  245.  
  246. ( receive/send diagnostics - not yet implemented )
  247.  
  248. create readcap.blk
  249.     A c,
  250.     25 c,    ( read capacity )
  251.     0 c,    ( bit 0 = RELADR )
  252.     0 c, 0 w, 0 c,     ( 4 bytes logical block address )
  253.     0 c,    0 c,
  254.     0 c,    ( bit 0 = PMI )
  255.     0 w,
  256.  
  257. create readext.blk
  258.     A c,
  259.     28 c,    ( read extended )
  260.     0 c,    ( bit 0 = RELADR )
  261.     0 c, 0 w, 0 c,     ( 4 bytes logical block address )
  262.     0 c,    
  263.     0 w,    ( 2 bytes transfer length )
  264.     0 w,
  265.  
  266. create writext.blk
  267.     A c,
  268.     2A c,    ( write extended )
  269.     0 c,    ( bit 0 = RELADR )
  270.     0 c, 0 w, 0 c,     ( 4 bytes logical block address )
  271.     0 c,    
  272.     0 w,    ( 2 bytes transfer length )
  273.     0 w,
  274.  
  275. create seekext.blk
  276.     A c,
  277.     2B c,    ( seek extended )
  278.     0 c,    ( bit 0 = RELADR )
  279.     0 c, 0 w, 0 c,     ( 4 bytes logical block address )
  280.     0 c,    
  281.     0 ,
  282.     
  283. ( compare - not yet implemented )
  284.  
  285. create verify.blk
  286.     A c,
  287.     2F c,    ( verify )
  288.     0 c,    ( bit 0 = RELADR, bit 1 = BYTCHK )
  289.     0 c, 0 w, 0 c,     ( 4 bytes logical block address )
  290.     0 c,    
  291.     0 w,    ( verification length )
  292.     0 w,
  293.  
  294. ( read defect data, read/write data buffer - not yet implemented )
  295.  
  296. DECIMAL
  297.  
  298. 6 CONSTANT myDisk    ( SCSI address of my Disk )
  299.  
  300. variable numstring 20 vallot
  301. : input-number numstring 1+ 20 expect  numstring number? drop ;
  302.  
  303. : wait { nticks | #ticks -- }
  304.     call tickcount -> #ticks
  305.     BEGIN pause
  306.         call tickcount #ticks -
  307.         nticks >
  308.     UNTIL
  309. ;
  310.  
  311. ( SCSI routines follow )
  312.  
  313. : disp.s.m     ." Stat, Mess = " . . cr ;
  314.  
  315. : rsc scsireset ." reset code = " . cr ;
  316.  
  317. : format 600 format.blk myDisk doscsi disp.s.m ;
  318.  
  319. : vfy { | start -- }
  320.     ." enter start block : " input-number 256 /mod 
  321.     verify.blk 2+ !    verify.blk 6 + c!    0 verify.blk 2+ c!
  322.     ." enter # blocks : "      input-number verify.blk 8 + w! 
  323.     6000 verify.blk myDisk doscsi  disp.s.m
  324. ;
  325.  
  326.  
  327. : prep.select  ( for 32 bytes of mode data )
  328. scbuf 100 0 fill
  329. [ hex ] 
  330.  0 scbuf ! 
  331.  1 scbuf 4 + c!  6 scbuf 5 + c! 40 scbuf 6 + c! 3 scbuf 7 + c!
  332.  2 scbuf C + c!  A scbuf D + c!  A scbuf E + c! A scbuf F + c!
  333.               0 scbuf 10 + !  0 scbuf 14 + !
  334. 39 scbuf 18 + c! 6 scbuf 19 + c! 3 scbuf 1A + c! 3 scbuf 1B + c!
  335.              0 scbuf 1C + !
  336. [ decimal ]
  337. ;
  338.  
  339. : prep.default  ( for 10 bytes of mode data )
  340. scbuf 100 0 fill
  341. [ hex ] 
  342.  0 scbuf ! 
  343. 81 scbuf 4 + c!  0 scbuf 5 + c! 82 scbuf 6 + c! 0 scbuf 7 + c!
  344. B9 scbuf 8 + c!  0 scbuf 9 + c!
  345. [ decimal ]
  346. ;
  347.  
  348. : modeselect
  349.     prep.select
  350.     32 modesel.blk 5 + c!
  351.     120 modesel.blk myDisk scbuf 32 doscsi.wb
  352.     disp.s.m
  353. ;
  354.  
  355. : modedefault
  356.     prep.default 
  357.     10 modesel.blk 5 + c!
  358.     120 modesel.blk myDisk scbuf 10 doscsi.wb
  359.     disp.s.m
  360. ;
  361.  
  362. : modesense
  363.     63 modesense.blk 3 + c!
  364.     84 modesense.blk 5 + c!
  365.     120 modesense.blk myDisk scbuf 84 doscsi.rb
  366.     disp.s.m
  367. ;
  368.  
  369. : reqsense
  370.     120 reqsense.blk myDisk scbuf 19 doscsi.rb
  371.     disp.s.m
  372.     hex 
  373.     20 0 do scbuf i + c@ . loop 
  374.     decimal
  375. ;
  376.  
  377. : sense modesense scbuf 100 dump ;
  378.  
  379. : read.block ( block# -- )
  380.     256 /mod read.blk 2+ w! read.blk 4 + c!
  381.     1 read.blk 5 + c!
  382.     120 read.blk myDisk scbuf 512 doscsi.r
  383.     disp.s.m
  384. ;
  385.  
  386. : seek.block ( block# -- )
  387.     256 /mod seek.blk 2+ w! seek.blk 4 + c!
  388.     120 seek.blk myDisk doscsi
  389.     disp.s.m
  390. ;
  391.  
  392. : write.block ( block# -- )
  393.     256 /mod write.blk 2+ w! write.blk 4 + c!
  394.     1 write.blk 5 + c!
  395.     120 write.blk myDisk scbuf 512 doscsi.w
  396.     disp.s.m
  397. ;
  398.  
  399. create ddm 512 allot
  400. create dpm 512 allot
  401. create driver.block 2048 allot
  402.  
  403. : read.ddm
  404.     0 read.blk 2+ w! 0 read.blk 4 + c!
  405.     1 read.blk 5 + c!
  406.     120 read.blk myDisk ddm 512 doscsi.r
  407.     2drop
  408. ;
  409.  
  410. : read.dpm
  411.     0 read.blk 2+ w! 1 read.blk 4 + c!
  412.     1 read.blk 5 + c!
  413.     120 read.blk myDisk dpm 512 doscsi.r
  414.     2drop
  415. ;
  416.  
  417. .TRAP   _newptr,sys     $A51E
  418. hex 144 CONSTANT SysEvtMask decimal
  419.  
  420. VARIABLE syshp.drvr
  421.  
  422. : install.driver { | dstart dlength dbytes pointer -- }
  423.     read.ddm 
  424.     ddm 18 +  @ -> dstart
  425.     ddm 22 + w@ -> dlength
  426.     dlength 512 * -> dbytes
  427.     dstart 256 /mod read.blk 2+ w! read.blk 4 + c!
  428.     dlength read.blk 5 + c!
  429.     120 read.blk myDisk driver.block 512 dlength * doscsi.r
  430.     2drop
  431.     dbytes    MOVE.L (A6)+,D0
  432.         _newptr,sys ( get memory block in system heap )
  433.         MOVE.L A0,-(A6)     -> pointer
  434.     pointer 
  435.     IF    driver.block pointer dbytes cmove
  436.         pointer syshp.drvr !
  437.         ELSE ." Not enough system heap for installation." cr
  438.         THEN
  439. ;
  440.  
  441. CODE call.driver
  442.     MOVE.L D5,-(A7)
  443.     MOVE.L (A6)+,D5
  444.     MOVE.L (A6)+,A0
  445.     execute
  446.     MOVE.L (A7)+,D5
  447.     RTS
  448. END-CODE
  449.  
  450. : rdy.scsi
  451.     scsireset drop
  452.     240 wait ( until disk has finished resetting )
  453.     120 reqsense.blk myDisk scbuf 19 doscsi.rb 2drop
  454. ;
  455.  
  456. : mount.scsi
  457.     rdy.scsi
  458.     install.driver 
  459.     read.dpm
  460.     SysEvtMask @
  461.     0 SysEvtMask !
  462.     syshp.drvr @ dpm myDisk call.driver
  463.     SysEvtMask !
  464. ;
  465.  
  466. : test.blks 10 0 do i read.block scbuf 64 dump cr loop ;
  467.  
  468. : mount.n.bye mount.scsi bye ;
  469.  
  470. : read.cap
  471.     120 readcap.blk myDisk scbuf 8 doscsi.rb
  472.     abort" Can't read capacity" drop
  473.     cr
  474.     ." This disk contains " scbuf @ dup . 
  475.     ."  blocks of "    scbuf 4 + @ dup . ."  bytes." cr
  476.     ." Total capacity is " 1024 */ . ."  Kbytes." cr
  477. ;
  478.  
  479.